home *** CD-ROM | disk | FTP | other *** search
- /* */
- /* LoadMPEG_adpro.ma Alex Kazik 1994 */
- /* LoadMPEG_HAM6.ma */
- /* LoadMPEG_HAM8.ma Alle drei ARexx-Scripte sind zum laden von */
- /* MPEG-Animationen. Das Script xxx_adpro konvertiert */
- /* die Bilder mit hilfe von ADPro auf ein beliebiges */
- /* Format, dir Dither und Palette Option wird unterstāætzt. Dir Scripte */
- /* xxx_HAM* wandeln die Anim ohne ADPro in das HAM6/HAM8 format um. */
- /* */
- /* Alle verwendeten Programme zur decodiering der MPEG-Anims sowie der */
- /* Konvertierung yuv2ppm und ppm2ilbm sind Public-Domain. */
- /* */
- /* */
- /* please read the .doc for english infomation */
-
-
- OPTIONS RESULTS
-
- address MAINACTOR
- printandstoretxt "ALX:MPEG Loader - by Alex Kazik 1994"
-
- RequestFile "Select MPEG-File"
- IF RC = 10 THEN
- call xEXIT 1
- mpgfile = RESULT
-
- if ( exists(mpgfile) = 0 ) then
- call xexit 6
-
- RequestSaveFile "Select Dest-File"
- IF RC = 10 THEN
- call xEXIT 1
- newname = RESULT
-
- IF exists(newname) then do
- printtxt "ALX:File already exists, replace?"
- RequestSaveFile "Replace File -> select again!"
- IF (RC = 10) | (RESULT ~= newname) then
- call xexit 5
- ADDRESS COMMAND 'delete' newname
- end
-
- printtxt "ALX:Decoding MPEG..."
- ADDRESS COMMAND 'copy' mpgfile newname || '.mpg'
- wbtofront
- ADDRESS COMMAND 'MainActor:mpeg/mpeg -d' newname '>CON:'
- screentofront
- printtxt "ALX:Deleting TEMP."
- ADDRESS COMMAND 'delete' newname || '.mpg'
- pics=0
- picname = newname || pics
- if exists(picname || ".Y") = 0 then do
- call xexit 2
- end
- if exists(picname || ".U") = 0 then do
- call xexit 2
- end
- if exists(picname || ".V") = 0 then do
- call xexit 2
- end
- pics=1
- picname = newname || pics
- if exists(picname || ".Y") = 0 then do
- call xexit 7
- end
- if exists(picname || ".U") = 0 then do
- call xexit 7
- end
- if exists(picname || ".V") = 0 then do
- call xexit 7
- end
- xxx = 1
- do while xxx = 1
- pics = pics + 1
- picname = newname || pics
- if exists(picname || ".Y") = 0 then
- xxx = 0
- if exists(picname || ".U") = 0 then
- xxx = 0
- if exists(picname || ".V") = 0 then
- xxx = 0
- end
- printandstoretxt "ALX:Could find" pics "Pictures."
- RequestInteger 352 "Original picture-width of the MEPG"
- IF RC = 10 THEN
- call xEXIT
- width=RESULT
- RequestInteger 240 "Original picture-height of the MPEG"
- IF RC = 10 THEN
- call xEXIT 1
- height=RESULT
-
- DO i=1 to pics
- yuvpic = i - 1
- yuvname = newname || yuvpic
- actualpic=newname || "." || Right("00000" || i, 5)
-
- printtxt "ALX:Converting Pic" i || "/" || pics || ". (YUV -> PPM)"
- ADDRESS COMMAND 'MainActor:mpeg/cyuv2ppm' yuvname 'T:ppm.TEMP' '-iw' width '-ih' height
- printtxt "ALX:Converting Pic" i || "/" || pics || ". (PPM -> IFF)"
- ADDRESS COMMAND 'MainActor:mpeg/ppmtoilbm >' || actualpic '-24FORCE' 'T:ppm.TEMP'
- printtxt "ALX:Converting Pic" i || "/" || pics || ". (deleting TEMP)"
- ADDRESS COMMAND 'delete' yuvname || ".?"
- END
-
- ADDRESS COMMAND 'delete t:ppm.TEMP'
-
- IF ~SHOW('P','ADPro') THEN DO
- PrintTXT "ALX:Invoking AdPro..."
- ADDRESS COMMAND 'run >NIL: <NIL: adpro:adpro BEHIND MAXMEM=1000000'
- ADDRESS COMMAND Wait 1
- i = 1
- j = 30
- DO UNTIL (SHOW('P','ADPro')) | (i=0)
- ADDRESS COMMAND Wait 1
- PrintTXT "ALX:Invoking AdPro... (" || i || " sec)"
- i = i + 1
- if (i=j) then do
- RequestInteger 0 "Who long I should sill wait? (until now " || i || 'sec | 0=Abb.)'
- IF RC = 10 then
- i = 0
- ELSE DO
- j = j + RESULT
- if i = j then
- i = 0
- END
- END
- END
- CloseADPro = 1
- END
- ELSE
- CloseADPro = 0
-
- NL = '0A'X
- ADDRESS "ADPro"
- ADPRO_TO_FRONT
- TempDefaults = "T:TempADProDefaults"
- SAVE_DEFAULTS TempDefaults
- PSTATUS
- oldPSTATUS = ADPRO_RESULT
- LOAD_TYPE REPLACE
- oldLoadType = ADPRO_RESULT
- ORIENTATION PORTRAIT
- oldLoadOrient = ADPRO_RESULT
- LFORMAT "IFF"
- oldLoader = ADPRO_RESULT
- IF (RC ~= 0) THEN DO
- ADPRO_TO_FRONT
- call xexit 3
- END
- SFORMAT "ANIM"
- oldSaver = ADPRO_RESULT
- IF (RC ~= 0) THEN DO
- ADPRO_TO_FRONT
- call xexit 4
- END
-
- CALL GetColors
- RENDER_TYPE colors
- CALL GetPalette
-
- if (palette = "Load") then do
- GETFILE '"Select Palette"' "ADPRO:Colors"
- IF (RC ~= 0) then
- call xexit 1
- palettename = ADPRO_RESULT
- PLOAD palettename
- palette="Locked"
- end
- if (palette = "Locked") then do
- PSTATUS locked
- cpf = "CPF=NO"
- end
- else do
- PSTATUS UnLocked
- cpf = "CPF=YES"
- end
- CALL GetDither
- DITHER dithermode
-
- ADDRESS MAINACTOR
- screentofront
- DO i=1 to pics
- actualpic=newname || "." || Right("00000" || i, 5)
-
- ADDRESS MAINACTOR
- printtxt "ALX:Converting Pic" i || "/" || pics || ". (ADPro)"
-
- ADDRESS "ADPro"
- Load actualpic
- Execute
- Save newname "APPEND" "IMAGE"
-
- ADDRESS MAINACTOR
- printtxt "ALX:Converting Pic" i || "/" || pics || ". (deleting TEMP)"
- ADDRESS COMMAND 'delete' actualpic
- END
-
- ADDRESS "ADPro"
- Save newname "QUIT" "IMAGE"
-
- ADDRESS MAINACTOR
- GetSPName
-
- if (rc = 0) then
- OpenNewProject
- SetSPLoader "ANIM" "IFF-Anim5"
- LoadProject newname
-
- CALL xEXIT 0
-
-
-
- GetColors:
- GetXX.1 = "2"
- GetXX.2 = "4"
- GetXX.3 = "8"
- GetXX.4 = "16"
- GetXX.5 = "32"
- GetXX.6 = "64"
- GetXX.7 = "128"
- GetXX.8 = "256"
- GetXX.9 = "EHB"
- GetXX.10 = "HAM"
- GetXX.11 = "HAM8"
- GetXXMin = 1
- GetXXMax = 11
- GetXXDef = 8
- CALL GetLV colors
- PARSE VAR RESULT nr '"'colors'"' .
- PARSE VAR colors colors .
- if (nr = 0) then
- call xexit 1
- return
-
-
-
- GetPalette:
- ARG is
- GetXX.1 = "Locked"
- GetXX.2 = "UnLocked"
- GetXX.3 = "Load PAL"
- GetXXMin = 1
- GetXXMax = 3
- GetXXDef = 2
- CALL GetLV "Palette"
- PARSE VAR RESULT nr '"'palette'"' .
- PARSE VAR palette palette .
- if (nr = 0) then
- call xexit 1
- return
-
-
-
- GetDither:
- ARG is
- GetXX.1 = "Off (0)"
- GetXX.2 = "Floyd (1)"
- GetXX.3 = "Burkes (2)"
- GetXX.4 = "Sierra (3)"
- GetXX.5 = "Jarvis (4)"
- GetXX.6 = "Stucki (5)"
- GetXX.7 = "Random (6)"
- GetXX.8 = "Lg Ord (7)"
- GetXX.9 = "Sm Ord (8)"
- GetXXMin = 1
- GetXXMax = 9
- GetXXDef = 1
- CALL GetLV "DITHER"
- PARSE VAR RESULT dithermode '"'nr'"' .
- if (dithermode = 0) then
- call xexit 1
- dithermode = dithermode - 1
- IF (Dithermode = 6) | (Dithermode = 7) | (Dithermode = 8) THEN DO
- continue = 0
- ADDRESS "ADPro"
- GETNUMBER '"Enter Dither Amount"' 16 1 256
- DitherAmt = ADPRO_RESULT
-
- IF (RC ~= 0) THEN
- call xexit 1
- DITHER_AMOUNT ditheramt
- END
- return
-
-
-
- xexit:
- ARG fehler
- if (fehler = 0) then
- fehler = "Done."
- else if (fehler = 1) then
- fehler = "Aborted!"
- else if (fehler = 2) then
- fehler = "Error while decoding."
- else if (fehler = 3) then
- fehler = "No IFF-Loader (ADPro)."
- else if (fehler = 4) then
- fehler = "No ANIM-Saver (ADPro)."
- else if (fehler = 5) then
- fehler = "File already exists."
- else if (fehler = 6) then
- fehler = "File don't exist."
- else if (fehler = 7) then
- fehler = "Anim must have min. 2 Pics."
- IF SHOW('P','ADPro') THEN DO
- address "ADPro"
- adpro_to_front
- if (fehler ~= "Done.") then
- OKAY1 fehler
- LFORMAT oldLoader
- SFORMAT oldSaver
- PSTATUS oldpstatus
- LOAD_TYPE oldLoadType
- ORIENTATION oldLoadOrient
- IF (EXISTS( TempDefaults )) THEN DO
- LOAD_DEFAULTS TempDefaults
- IF (RC ~= 0) THEN DO
- ADPRO_TO_FRONT
- OKAY1 "Error restoring settings."
- ADPRO_TO_BACK
- END
- ADDRESS COMMAND "Delete >NIL:" TempDefaults
- END
- if CloseADPro then do
- OKAY2 "Should I quit ADPro?" || NL || NL || " OK - Yep" || NL || "CANCEL - NO."
- IF RC ~= 0 then
- ADPRO_EXIT
- END
- end
-
- address MAINACTOR
- Screentofront
- PrintAndStoreTxt "ALX:" || fehler
- exit
-
-
-
- GetLV:
- ARG GetXXTitle
- GetXXReq = 0
- String = '"' || GetXX.GetXXDef || '"'
- DO LoopCounter = GetXXMin TO GetXXMax
- String = String '"' || GetXX.LoopCounter || '"'
- END
- ADDRESS "ADPro"
- ADPRO_TO_FRONT
-
- continue = 0
- DO UNTIL (continue = 1)
- LISTVIEW GetXXTitle (GetXXMax-GetXXMin+1) ITEMS String
- LISTVIEW_RC = RC
- PARSE VAR ADPRO_RESULT '"'GetXXStr'"' scratch
-
- GetXXRet = GetXXMin
- DO WHILE (GetXXRet <= GetXXMax) & (COMPARE( GetXXStr, GetXX.GetXXRet ) ~= 0)
- GetXXRet = GetXXRet + 1
- END
-
- IF ((LISTVIEW_RC ~= 0) & (LISTVIEW_RC ~= 1)) | (GetXXStr=" -----") THEN DO
- OKAY2 "This value is requied." || NL || NL || " OK - Try it againl" || NL || "CANCEL - Abort."
- IF (RC = 0) THEN do
- GetXXRet=0
- continue=1
- end
- END
- ELSE
- continue = 1
- END
- if (GetXXRet > GetXXMax) then
- GetXXRet=0
- Return GetXXRet '"' || GetXXStr || '"'
-